home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / unix / tkUnixInit.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  2.9 KB  |  131 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tkUnixInit.c --
  3.  *
  4.  *    This file contains Unix-specific interpreter initialization
  5.  *    functions.
  6.  *
  7.  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  8.  *
  9.  * See the file "license.terms" for information on usage and redistribution
  10.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11.  *
  12.  * SCCS: @(#) tkUnixInit.c 1.24 97/07/24 14:46:09
  13.  */
  14.  
  15. #include "tkInt.h"
  16. #include "tkUnixInt.h"
  17.  
  18. /*
  19.  * The Init script (common to Windows and Unix platforms) is
  20.  * defined in tkInitScript.h
  21.  */
  22. #include "tkInitScript.h"
  23.  
  24.  
  25. /*
  26.  * Default directory in which to look for libraries:
  27.  */
  28.  
  29. static char defaultLibraryDir[200] = TK_LIBRARY;
  30.  
  31.  
  32. /*
  33.  *----------------------------------------------------------------------
  34.  *
  35.  * TkpInit --
  36.  *
  37.  *    Performs Unix-specific interpreter initialization related to the
  38.  *      tk_library variable.
  39.  *
  40.  * Results:
  41.  *    Returns a standard Tcl result.  Leaves an error message or result
  42.  *    in interp->result.
  43.  *
  44.  * Side effects:
  45.  *    Sets "tk_library" Tcl variable, runs "tk.tcl" script.
  46.  *
  47.  *----------------------------------------------------------------------
  48.  */
  49.  
  50. int
  51. TkpInit(interp)
  52.     Tcl_Interp *interp;
  53. {
  54.     char *libDir;
  55.  
  56.     libDir = Tcl_GetVar(interp, "tk_library", TCL_GLOBAL_ONLY);
  57.     if (libDir == NULL) {
  58.     Tcl_SetVar(interp, "tk_library", defaultLibraryDir, TCL_GLOBAL_ONLY);
  59.     }
  60.     TkCreateXEventSource();
  61.     return Tcl_Eval(interp, initScript);
  62. }
  63.  
  64. /*
  65.  *----------------------------------------------------------------------
  66.  *
  67.  * TkpGetAppName --
  68.  *
  69.  *    Retrieves the name of the current application from a platform
  70.  *    specific location.  For Unix, the application name is the tail
  71.  *    of the path contained in the tcl variable argv0.
  72.  *
  73.  * Results:
  74.  *    Returns the application name in the given Tcl_DString.
  75.  *
  76.  * Side effects:
  77.  *    None.
  78.  *
  79.  *----------------------------------------------------------------------
  80.  */
  81.  
  82. void
  83. TkpGetAppName(interp, namePtr)
  84.     Tcl_Interp *interp;
  85.     Tcl_DString *namePtr;    /* A previously initialized Tcl_DString. */
  86. {
  87.     char *p, *name;
  88.  
  89.     name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
  90.     if ((name == NULL) || (*name == 0)) {
  91.     name = "tk";
  92.     } else {
  93.     p = strrchr(name, '/');
  94.     if (p != NULL) {
  95.         name = p+1;
  96.     }
  97.     }
  98.     Tcl_DStringAppend(namePtr, name, -1);
  99. }
  100.  
  101. /*
  102.  *----------------------------------------------------------------------
  103.  *
  104.  * TkpDisplayWarning --
  105.  *
  106.  *    This routines is called from Tk_Main to display warning
  107.  *    messages that occur during startup.
  108.  *
  109.  * Results:
  110.  *    None.
  111.  *
  112.  * Side effects:
  113.  *    Generates messages on stdout.
  114.  *
  115.  *----------------------------------------------------------------------
  116.  */
  117.  
  118. void
  119. TkpDisplayWarning(msg, title)
  120.     char *msg;            /* Message to be displayed. */
  121.     char *title;        /* Title of warning. */
  122. {
  123.     Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
  124.     if (errChannel) {
  125.     Tcl_Write(errChannel, title, -1);
  126.     Tcl_Write(errChannel, ": ", 2);
  127.     Tcl_Write(errChannel, msg, -1);
  128.     Tcl_Write(errChannel, "\n", 1);
  129.     }
  130. }
  131.